home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / BORL_TIP / TI100 / TI669.ASC < prev    next >
Text File  |  1992-08-12  |  4KB  |  199 lines
  1.  
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.   PRODUCT  :  Turbo Pascal                           NUMBER  :  669
  9.   VERSION  :  6.0
  10.        OS  :  MS/PC DOS
  11.      DATE  :  August 12, 1992                          PAGE  :  1/3
  12.  
  13.     TITLE  :  Change Menubar at Runtime
  14.  
  15.  
  16.  
  17.  
  18.   {
  19.  
  20.   This program changes the menubar at runtime as well
  21.   as demonstrates how to create a menuitem that does not
  22.   have a submenu.
  23.  
  24.   }
  25.   {$X+}
  26.   program ExampleProgram;
  27.  
  28.   uses
  29.     Drivers, Objects, Views, App, Menus, Puzzle, Calendar;
  30.     const
  31.     PuzzleCmd   = 100;
  32.     CalendarCmd = 101;
  33.     SwitchCmd   = 102;
  34.  
  35.   type
  36.     TTestMain = object(TApplication)
  37.       OtherMenu: PMenuBar;
  38.       constructor Init;
  39.       procedure Calendar;
  40.       procedure HandleEvent(var Event: TEvent); virtual;
  41.       procedure InitMenuBar; virtual;
  42.       procedure Puzzle;
  43.       procedure SwitchMenu;
  44.     end;
  45.  
  46.   { TTestMain }
  47.   constructor TTestMain.Init;
  48.   begin
  49.     TApplication.Init;
  50.   end;
  51.  
  52.   procedure TTestMain.Calendar;
  53.   var
  54.     CalendarWindow: PCalendarWindow;
  55.   begin
  56.     CalendarWindow := new(PCalendarWindow, Init);
  57.     DeskTop^.Insert(CalendarWindow);
  58.   end;
  59.  
  60.   procedure TTestMain.HandleEvent(var Event: TEvent);
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.   PRODUCT  :  Turbo Pascal                           NUMBER  :  669
  75.   VERSION  :  6.0
  76.        OS  :  MS/PC DOS
  77.      DATE  :  August 12, 1992                          PAGE  :  2/3
  78.  
  79.     TITLE  :  Change Menubar at Runtime
  80.  
  81.  
  82.  
  83.  
  84.   begin
  85.     TApplication.HandleEvent(Event);
  86.     if Event.What = evCommand Then
  87.     begin
  88.       case Event.Command of
  89.         PuzzleCmd   : Puzzle;
  90.         CalendarCmd : Calendar;
  91.         SwitchCmd   : SwitchMenu;
  92.       else
  93.         Exit;
  94.       end;
  95.       ClearEvent(Event);
  96.     end;
  97.   end;
  98.  
  99.   Procedure TTestMain.InitMenuBar;
  100.   var
  101.     R: TRect;
  102.   begin
  103.     GetExtent(R);
  104.     R.B.Y := R.A.Y+1;
  105.     MenuBar := New(PMenuBar, Init(R, NewMenu(
  106.        NewItem('~S~witch Menus','', 0, SwitchCmd, hcNoContext,
  107.        NewSubMenu('~E~xample',hcNoContext,NewMenu(
  108.        NewItem('~P~uzzle','', 0, PuzzleCmd, hcNoContext,
  109.        NewItem('~C~alendar','', 0, CalendarCmd, hcNoContext,
  110.        NewLine(
  111.        NewItem('~Q~uit', '',0, cmQuit,
  112.   hcNoContext,Nil))))),Nil)))));
  113.     OtherMenu := New(PMenuBar, Init(R, NewMenu(
  114.        NewItem('~S~witch Menus','', 0, SwitchCmd, hcNoContext,
  115.        NewSubMenu('~O~ther Menu',hcNoContext,NewMenu(
  116.        NewItem('~B~y', '', 0, cmQuit, hcNoContext,
  117.        NewLine(
  118.        NewItem('~Q~uit', '',0, cmQuit,
  119.   hcNoContext,Nil)))),Nil)))));
  120.   end;
  121.  
  122.   procedure TTestMain.Puzzle;
  123.   var
  124.    PuzzleWindow: PPuzzleWindow;
  125.   begin
  126.     PuzzleWindow := new(PPuzzleWindow, Init);
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.   PRODUCT  :  Turbo Pascal                           NUMBER  :  669
  141.   VERSION  :  6.0
  142.        OS  :  MS/PC DOS
  143.      DATE  :  August 12, 1992                          PAGE  :  3/3
  144.  
  145.     TITLE  :  Change Menubar at Runtime
  146.  
  147.  
  148.  
  149.  
  150.     DeskTop^.Insert(PuzzleWindow);
  151.   end;
  152.  
  153.   procedure TTestMain.SwitchMenu;
  154.   var
  155.     Temp: PMenuBar;
  156.   begin
  157.     Delete(MenuBar);
  158.     Temp := PMenuBar(MenuBar);
  159.     MenuBar := OtherMenu;
  160.     OtherMenu := Temp;
  161.     Insert(MenuBar);
  162.     MenuBar^.DrawView;
  163.   end;
  164.  
  165.   var
  166.     TestMain: TTestMain;
  167.  
  168.   begin
  169.     TestMain.Init;
  170.     TestMain.Run;
  171.     TestMain.Done;
  172.   end.
  173.  
  174.   DISCLAIMER: You have the right to use this technical information
  175.   subject to the terms of the No-Nonsense License Statement that
  176.   you received with the Borland product to which this information
  177.   pertains.
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.